home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor04c.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  4KB  |  164 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor04c;
  9.  
  10. uses Memory, TutConst, Drivers, Objects, Views, Menus, App, MsgBox,
  11.   Editors, StdDlg;
  12.  
  13. type
  14.   TTutorApp = object(TApplication)
  15.     constructor Init;
  16.     procedure DoAboutBox;
  17.     procedure HandleEvent(var Event: TEvent); virtual;
  18.     procedure InitMenuBar; virtual;
  19.     procedure InitStatusLine; virtual;
  20.     procedure NewWindow;
  21.     procedure OpenWindow;
  22.   end;
  23.  
  24. constructor TTutorApp.Init;
  25. begin
  26.   MaxHeapSize := 8192;
  27.   EditorDialog := StdEditorDialog;
  28.   inherited Init;
  29.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  30. end;
  31.  
  32. procedure TTutorApp.DoAboutBox;
  33. begin
  34.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  35.     #3'Copyright 1992'#13#3'Borland International',
  36.     nil, mfInformation or mfOKButton);
  37. end;
  38.  
  39. procedure TTutorApp.HandleEvent(var Event: TEvent);
  40. var
  41.   R: TRect;
  42. begin
  43.   inherited HandleEvent(Event);
  44.   if Event.What = evCommand then
  45.   begin
  46.     case Event.Command of
  47.       cmNew:
  48.         begin
  49.           NewWindow;
  50.           ClearEvent(Event);
  51.         end;
  52.       cmOpen:
  53.         begin
  54.           OpenWindow;
  55.           ClearEvent(Event);
  56.         end;
  57.       cmOptionsVideo:
  58.         begin
  59.           SetScreenMode(ScreenMode xor smFont8x8);
  60.           ClearEvent(Event);
  61.         end;
  62.       cmAbout:
  63.         begin
  64.           DoAboutBox;
  65.           ClearEvent(Event);
  66.         end;
  67.     end;
  68.   end;
  69. end;
  70.  
  71. procedure TTutorApp.InitMenuBar;
  72. var
  73.   R: TRect;
  74. begin
  75.   GetExtent(R);
  76.   R.B.Y := R.A.Y + 1;
  77.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  78.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  79.       StdFileMenuItems(nil)),
  80.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  81.       StdEditMenuItems(
  82.       NewLine(
  83.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  84.       nil)))),
  85.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  86.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  87.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  88.       NewLine(
  89.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  90.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  91.       nil)))))),
  92.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  93.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  94.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  95.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  96.       nil)))),
  97.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  98.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  99.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  100.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  101.       NewLine(
  102.       StdWindowMenuItems(nil)))))),
  103.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  104.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  105.       nil)),
  106.     nil))))))
  107.   )));
  108. end;
  109.  
  110. procedure TTutorApp.InitStatusLine;
  111. var
  112.   R: TRect;
  113. begin
  114.   GetExtent(R);
  115.   R.A.Y := R.B.Y - 1;
  116.   New(StatusLine, Init(R,
  117.     NewStatusDef(0, $EFFF,
  118.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  119.       NewStatusKey('~F4~ New', kbF4, cmNew,
  120.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  121.       StdStatusKeys(nil)))),
  122.     NewStatusDef($F000, $FFFF,
  123.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  124.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  125.       StdStatusKeys(nil))), nil))));
  126. end;
  127.  
  128. procedure TTutorApp.NewWindow;
  129. var
  130.   R: TRect;
  131.   TheWindow: PEditWindow;
  132. begin
  133.   R.Assign(0, 0, 60, 20);
  134.   TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  135.   InsertWindow(TheWindow);
  136. end;
  137.  
  138. procedure TTutorApp.OpenWindow;
  139. var
  140.   R: TRect;
  141.   FileDialog: PFileDialog;
  142.   TheFile: FNameStr;
  143. const
  144.   FDOptions: Word = fdOKButton or fdOpenButton;
  145. begin
  146.   TheFile := '*.*';
  147.   New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
  148.     FDOptions, 1));
  149.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  150.   begin
  151.     R.Assign(0, 0, 75, 20);
  152.     InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
  153.   end;
  154. end;
  155.  
  156. var
  157.   TutorApp: TTutorApp;
  158.  
  159. begin
  160.   TutorApp.Init;
  161.   TutorApp.Run;
  162.   TutorApp.Done;
  163. end.
  164.